home *** CD-ROM | disk | FTP | other *** search
/ PsL Monthly 1993 December / PSL Monthly Shareware CD-ROM (December 1993).iso / prgmming / dos / pascal / miscuni.com / DATAENTR.PAS < prev    next >
Encoding:
Pascal/Delphi Source File  |  1989-05-25  |  14.0 KB  |  395 lines
  1. (*************************************************************************)
  2. (*                               DataEntry                               *)
  3. (*                                                                       *)
  4. (* Author:  Geoffrey Moehrke                                             *)
  5. (* Date:    February 13, 1989                                            *)
  6. (*                                                                       *)
  7. (* Purpose: Allow user to input a group of values of mixed types in a    *)
  8. (*          window, moving from field to field using arrow keys.         *)
  9. (*                                                                       *)
  10. (* Source: F:\TP\UNIT\DATAENTR.PAS                                       *)
  11. (*************************************************************************)
  12. Unit DataEntry;
  13.  
  14. Interface
  15.  
  16.     Uses
  17.       TPCRT,
  18.       {$IFDEF UseClock}
  19.       TPClock,
  20.       {$ENDIF}
  21.       TPWindow,
  22.       TPString,
  23.       TPEdit,
  24.       Keys,
  25.       Messages;
  26.  
  27.   const
  28.  
  29.      MaxFields = 12;         { Max number of data entry fields     }
  30.  
  31.      DEWinWidth = 65;        { Default width of the window         }
  32.  
  33.      DEAcceptKey: Word = F2; { Default key to accept entered data  }
  34.  
  35.   type
  36.  
  37.      FieldType = (DE_Y,    { boolean }
  38.                   DE_B,    { byte    }
  39.                   DE_I,    { integer }
  40.                   DE_W,    { word    }
  41.                   DE_L,    { longint }
  42.                   DE_R,    { real    }
  43.                   DE_C,    { char    }
  44.                   DE_S );  { string  }
  45.  
  46.      InputDesc = Record
  47.                    Defined  : boolean;
  48.                    Prompt   : string;
  49.                    FldType  : FieldType;
  50.                    FieldLen : byte;
  51.                    MaxVal,
  52.                    MinVal   : longint;
  53.                    DecPlaces,
  54.                    Size     : Byte;
  55.                    Data     : Pointer;
  56.                  end;
  57.  
  58.  
  59.      DescArray = Array[1..MaxFields] of InputDesc;
  60.  
  61.      StrFunc = function( FieldNum : byte; Data: pointer ): string;
  62.        { Function to alter how a field appears on the screen -
  63.          called each time each field is drawn on the screen.    }
  64.  
  65.     var
  66.       Fields           : DescArray;
  67.       DefinedFlds      : byte;
  68.       DEWinAttr,
  69.       DEFrameAttr,
  70.       DEHeaderAttr,
  71.       DELoAttr,
  72.       DEHiAttr,
  73.       DESelectAttr    : byte;
  74.       DefUsrFunc      : StrFunc;
  75.  
  76.  
  77.     procedure DefineField( FN : byte;        { Field Number    }
  78.                            P  : string;      { Prompt          }
  79.                            FT : FieldType;   { Type            }
  80.                            FL : byte;        { Field Length    }
  81.                            Min,              { Max Val         }
  82.                            Max: longint;     { Min Val         }
  83.                            DP,               { Decimal Places  }
  84.                            Sz : byte;        { Size of data    }
  85.                            Ptr: pointer );   { Pointer to data }
  86.  
  87.       { Define the field - does not check if already defined just redefines }
  88.  
  89.  
  90.     procedure UndefineField( FN : byte );
  91.       { Undefine the field FN }
  92.  
  93.     procedure UndefineAllFields;
  94.       { Undefine all defined data entry fields }
  95.  
  96.     function DataGet( Title: String;
  97.                       Edit: Boolean;
  98.                       UsrFunc: StrFunc ): Boolean;
  99.  
  100.       { Read in the defined fields, if Edit param is false, assumes that
  101.         Title will contain a yes or no question and returns a corresponding
  102.         True/False value of the user response                               }
  103.  
  104.   implementation
  105.  
  106.     procedure DefineField( FN : byte;        { Field Number    }
  107.                            P  : string;      { Prompt          }
  108.                            FT : FieldType;   { Type            }
  109.                            FL : byte;        { Field Length    }
  110.                            Min,              { Max Val         }
  111.                            Max: longint;     { Min Val         }
  112.                            DP,               { Decimal Places  }
  113.                            Sz : byte;        { Size of data    }
  114.                            Ptr: pointer );   { Pointer to data }
  115.  
  116.  
  117.     { Define the field - does not check if already defined just redefines }
  118.  
  119.     begin
  120.       With Fields[FN] do begin
  121.         If Not Defined then begin
  122.           Defined := True;
  123.           Inc( DefinedFlds ); { Update global counter }
  124.         end;
  125.         Prompt := P;
  126.         FldType := FT;
  127.         FieldLen := FL;
  128.         MaxVal := Max;
  129.         MinVal := Min;
  130.         DecPlaces := DP;
  131.         Size := Sz;
  132.         Data := Ptr;
  133.       end
  134.     end;
  135.  
  136.  
  137.     procedure UndefineField( FN : byte );
  138.  
  139.     { Undefine the field }
  140.  
  141.     begin
  142.       With Fields[FN] do
  143.        If Defined then begin
  144.          Fields[FN].Defined := False;
  145.          If DefinedFlds > 0 then
  146.            Dec( DefinedFlds )
  147.        end
  148.     end;
  149.  
  150.     procedure UndefineAllFields;
  151.       { Undefine all data entry fields }
  152.  
  153.       var I : Byte;
  154.  
  155.     begin
  156.       For I := 1 to DefinedFlds do
  157.         UndefineField(I);
  158.     end;
  159.  
  160. {$F+}
  161.     function DefStrFunc( FieldNum : Byte; Data : Pointer ): String;
  162.  
  163.     begin
  164.       Case Fields[FieldNum].FldType of
  165.         DE_Y : If boolean( Data^ ) then
  166.                  DefStrFunc := 'Y'
  167.                else
  168.                  DefStrFunc := 'N';
  169.         DE_B  : DefStrFunc := Long2Str( byte( Data^ ) );
  170.         DE_I  : DefStrFunc := Long2Str( integer( Data^ ) );
  171.         DE_W  : DefStrFunc := Long2Str( word( Data^ ) );
  172.         DE_L  : DefStrFunc := Long2Str( longint( Data^ ) );
  173.         DE_R  : DefStrFunc := Real2Str(real( Data^ ),7,2);
  174.         DE_C  : DefStrFunc := char( Data^ );
  175.         DE_S  : DefStrFunc := String( Data^ )
  176.       end
  177.     end; { DefStrFunc }
  178. {$F-}
  179.  
  180.  
  181.     function DataGet( Title: String;
  182.                       Edit: Boolean;
  183.                       UsrFunc: StrFunc ): Boolean;
  184.  
  185.       { Read in the defined fields }
  186.  
  187.      var
  188.  
  189.        Escaped,
  190.        Return,
  191.        EditCh,
  192.        InvKey : boolean;
  193.        Temp   : boolean;
  194.        Pos    : byte;
  195.        Key    : Word;
  196.        DEWin  : WindowPtr;
  197.        Int    : integer;
  198.        St     : string;
  199.        Bool   : boolean;
  200.        Wrd    : word;
  201.        LInt   : longint;
  202.        Ch     : char;
  203.        R      : real;
  204.  
  205.     begin
  206.     DataGet := False;
  207.     CursorToEnd := False;
  208.  
  209.     { NOTE: If these fields are defined within the calling program - they will
  210.             need to be re-defined after each call to DataGet                   }
  211.  
  212.       if Not AddEditCommand( RSUser0, 1, UpArrow, $0000 ) Or
  213.          Not AddEditCommand( RSUser1, 1, DnArrow, $0000 ) Or
  214.          Not AddEditCommand( RSUser2, 1, F2,      $0000 ) then
  215.            Message(TitleCmd+PauseCmd+TitleCmd+'Program Error - edit key array full - DataGet procedure');
  216.  
  217.       Escaped := False;
  218.       If Not MakeWindow(DEWin,
  219.                         40 - (DEWinWidth div 2) - 1, 12 - (DefinedFlds Div 2) - 2,
  220.                         40 + (DEWinWidth div 2) + 1, 12 + (DefinedFlds Div 2) + 2,
  221.                         True, True, False,
  222.                         DEWinAttr, DEFrameAttr, DEHeaderAttr,'') then begin
  223.           Message(TitleCmd+PauseCmd+TitleCmd+'Not Enough Memory.');
  224.           Exit
  225.         end;
  226.       If Not DisplayWindow(DEWin) then begin
  227.         Message(TitleCmd+PauseCmd+TitleCmd+'Not Enough Memory.');
  228.         Exit
  229.       end;
  230.       FastWriteWindow( Center( Title, DEWinWidth ), 1, 1, DEHeaderAttr );
  231.  
  232.       For Pos := 1 to DefinedFlds do  { Write initial data }
  233.         With Fields[Pos] do begin
  234.           FastWriteWindow( Pad(Prompt, DEWinWidth) , Pos+2, 1, DEHiAttr);
  235.           FastWriteWindow( UsrFunc( Pos, Data ), Pos+2, Length( Prompt )+2 ,DELoAttr );
  236.         end;
  237.  
  238.       Pos := 1;
  239.       If Edit then
  240.         Repeat
  241.           invKey := False;
  242.           With Fields[Pos] do begin
  243.             FastWriteWindow( pad(Prompt, DEWinWidth), Pos+2,1,DESelectAttr );
  244.             FastWriteWindow( UsrFunc( Pos, Data ), Pos+2,Length(Prompt)+2, DESelectAttr );
  245.             GotoXY( Length( Prompt ) + 2, Pos+2 );
  246.  
  247.             Repeat
  248.             until CheckKbd( Key );  { Wait for keystroke }
  249.             EditCh :=  EditKey( Key );
  250.             If (char(lo(Key)) In[#32..#126]) Or (EditCh) then begin
  251.               Case FldType of
  252.                DE_B : If (char(lo(Key)) in ['0'..'9']) Or EditCh then begin
  253.                         Int := integer( byte( Data^ ) );
  254.                         ReadInteger( '', Pos+2, Length(Prompt)+2, FieldLen,
  255.                                      DESelectAttr, DESelectAttr,
  256.                                      MinVal, MaxVal, Escaped, Int);
  257.                         Move( byte(Int), Data^, Size )
  258.                         end
  259.                       else
  260.                         InvKey := True;
  261.                DE_Y : If UpCase(char(lo(key))) in ['Y','N'] then begin
  262.                          Temp := ShowReadChar;
  263.                          ShowReadChar := False;
  264.                          bool := YesOrNo( '', Pos+2, Length(Prompt)+2,
  265.                                           DESelectAttr, Ch );
  266.                          ShowReadChar := Temp;
  267.                          Move(bool, Data^, Size )
  268.                          end
  269.                        else
  270.                          InvKey := True;
  271.  
  272.  
  273.                DE_I : If (char(lo(Key)) in ['0'..'9','-']) Or EditCh then begin
  274.                         Int := integer( Data^ );
  275.                         ReadInteger( '', Pos+2, Length(Prompt)+2, FieldLen,
  276.                                      DESelectAttr, DESelectAttr,
  277.                                      MinVal, MaxVal, Escaped, Int);
  278.                         Move(Int, Data^, Size)
  279.                         end
  280.                       else
  281.                         Key := ReadkeyWord;
  282.                DE_W : If (char(lo(Key)) in ['0'..'9']) Or EditCh then begin
  283.                         Wrd := word( Data^ );
  284.                         ReadWord( '', Pos+2, Length(Prompt)+2, FieldLen,
  285.                                      DESelectAttr, DESelectAttr,
  286.                                      MinVal, MaxVal, Escaped, Wrd);
  287.                         Move( Wrd, Data^, Size )
  288.                         end
  289.                       else
  290.                         InvKey := True;
  291.                DE_L : If (char(lo(Key)) in ['0'..'9','-']) or EditCh then begin
  292.                         LInt := longint( Data^ );
  293.                         ReadLongInt( '', Pos+2, Length(Prompt)+2, FieldLen,
  294.                                      DESelectAttr, DESelectAttr,
  295.                                      MinVal, MaxVal, Escaped, LInt);
  296.                         Move( LInt, Data^, Size );
  297.                         end
  298.                       else
  299.                         InvKey := True;
  300.                DE_R : If (char(lo(Key)) in ['0'..'9','.','-']) or EditCh then  begin
  301.                         R := real( Data^ );
  302.                         ReadReal( '', Pos+2, Length(Prompt)+2, FieldLen,
  303.                                   DESelectAttr, DESelectAttr,
  304.                                   DecPlaces, MinVal*1.0, MaxVal*1.0, Escaped, R);
  305.                         Move( R, Data^, Size )
  306.                       end
  307.                       else
  308.                         InvKey := True;
  309.  
  310.                DE_C : begin
  311.                         Ch := char( Data^ );
  312.                         ReadCharacter( '', Pos+2, Length(Prompt)+2,
  313.                                        DESelectAttr, [#32..#255],
  314.                                        Ch );
  315.                         Move( Ch, Data^, Size )
  316.                       end;
  317.  
  318.                DE_S : begin
  319.                         St := string( Data^ );
  320.                         ReadString( '', Pos+2, Length(Prompt)+2, FieldLen,
  321.                                    DESelectAttr, DESelectAttr, DESelectAttr,
  322.                                    Escaped, St );
  323.                         Move( St, Data^, Size )
  324.                      end;
  325.               End;
  326.               FastWriteWindow( Pad(Prompt, DEWinWidth) ,Pos+2,1,DEHiAttr);
  327.               FastWriteWindow( UsrFunc( Pos, Data ),Pos+2,Length(Prompt)+2 ,DELoAttr );
  328.               If RSCommand = RSUser2 then
  329.                 Key := DEAcceptKey
  330.               else If RSCommand = RSUser0 then begin
  331.                 If Pos > 1 then Dec(Pos) else Pos := DefinedFlds;
  332.                 end
  333.               else if InvKey Then
  334.                 Key := ReadKeyWord   { Flush invalid keystrokes }
  335.               else                   {       otherwise          }
  336.                 Inc(Pos);            { move to next field       }
  337.               If Pos > DefinedFlds then
  338.                 Pos := 1;
  339.             end
  340.           else begin
  341.             Key := ReadKeyWord;
  342.             FastWriteWindow( Pad(Prompt,DEWinWidth), Pos+2,1,DEHiAttr);
  343.             FastWriteWindow( UsrFunc( Pos, Data ),Pos+2,Length(Prompt)+2 ,DELoAttr );
  344.  
  345.             If Key = Enter then
  346.               Key := DnArrow;
  347.  
  348.             If Key = UpArrow then
  349.               If Pos > 1 then Dec(Pos) else Pos := DefinedFlds;
  350.  
  351.             If Key = DnArrow then
  352.               If Pos < DefinedFlds then Inc(Pos) else Pos := 1;
  353.  
  354.           end;
  355.           If Escaped then Key := ESC;
  356.           Return := Not Escaped
  357.         end
  358.         until (Key = ESC)
  359.            Or (Key = DEAcceptKey)
  360.  
  361.       else begin
  362.         FastWriteWindow( Pad( Title, DEWinWidth ), 1, 1, DEHeaderAttr);
  363.         Return := YesOrNo('', 1, Length( Title )+1 , DEHeaderAttr, ' ');
  364.       end;
  365.       If Key = ESC then
  366.         Return := False;
  367.       DEWin := EraseTopWindow;
  368.       DisposeWindow( DEWin );
  369.       DataGet := Return;
  370.     end;
  371.  
  372.  
  373.  
  374.  
  375. Begin
  376.   FillChar(Fields, SizeOf( Fields ), #0 );
  377.   DefUsrFunc := DefStrFunc;
  378.   DefinedFlds := 0;
  379.   if LastMode In [2,7] then begin
  380.     DEWinAttr    := $07;
  381.     DEFrameAttr  := $07;
  382.     DEHeaderAttr := $0F;
  383.     DELoAttr     := $0F;
  384.     DEHiAttr     := $07;
  385.     DESelectAttr := $70;
  386.   end
  387.   else begin
  388.     DEWinAttr    := $47;
  389.     DEFrameAttr  := $47;
  390.     DEHeaderAttr := $4F;
  391.     DELoAttr     := $4B;
  392.     DEHiAttr     := $47;
  393.     DESelectAttr := $1F;
  394.   end
  395. end.